(use srfi-1)
(use text.tree)
(use text.html-lite)
(use util.match)
(use sxml.sxpath)
(use sxml.tools)
(use sxml.serializer)
(use www.cgi)
(use rfc.xmpp)

(define cont-table (make-hash-table))
(define kurl 0)
(define return #f)

(define (kurl-404 params)
  `(div
    (p "Continuation id is not found.")
    (table
     ,@(map (match-lambda
             ((a . b)
              `(tr
                (td ,a)
                (td ,b))))
            params))))

(define (show . args)
  (call/cc
   (lambda (cc)
     (hash-table-put! cont-table kurl cc)
     (inc! kurl)
     (return args))))

(define (call-with-cont-xmpp proc)
  (define (cont-xmpp params obj)
    (call/cc
     (lambda (cc)
       (set! return cc)
       (let1 k (cgi-get-parameter "kurl" params :default #f :convert x->number)
         (if (boolean k)
           ((hash-table-get cont-table k kurl-404) params)
           (proc obj))))))

  (define-method handle ((connection <connection>) (obj <message>))
    (let1 params (if (body-of obj)
                   (cgi-parse-parameters :query-string (body-of obj))
                   '())
      (for-each (match-lambda
                 ((sendto . page) (message-xhtml connection sendto "" page)))
                (cont-xmpp params obj)))))

(define (marrige message)
  (let* ((a (show `(,(from-of message) .
                    (form (|@| (onsubmit "return send_ex(this,'clergyman@localhost');"))
                          (p "Who do you want to marry?")
                          (select (|@| (name "target"))
                                  (option (|@| (value "juliet@localhost/Home"))
                                          "juliet")
                                  (option (|@| (value "romeo@localhost/Home"))
                                          "romeo"))
                          (input (|@| (type "hidden") (name "kurl") (value ,kurl)))
                          (input (|@| (type "submit") (value "send")))))))
         (b (show `(,(cgi-get-parameter "target" a) .
                    (form (|@| (onsubmit "return send_ex(this,'clergyman@localhost');"))
                          (p ,(from-of message) " propose you. How do you deal with it?")
                          (input (|@| (type "radio")  (name "answer") (value "accepted"))
                                 "Accept")
                          (input (|@| (type "radio")  (name "answer") (value "declined"))
                                 "Decline")
                          (input (|@| (type "hidden") (name "kurl") (value ,kurl)))
                          (input (|@| (type "submit") (value "send"))))))))
    (show `(,(from-of message) .
            (p ,(cgi-get-parameter "target" a) " "
               ,(cgi-get-parameter "answer" b) " "
               "your propose.")))))

(define (sum message)
  (let* ((a (show `(,(from-of message) .
                    (form (|@| (onsubmit "return send_ex(this,'clergyman@localhost');"))
                          (p "? + ? = ?")
                          (input (|@| (type "input") (name "value")))
                          (input (|@| (type "hidden") (name "kurl") (value ,kurl)))
                          (input (|@| (type "submit") (value "send")))))))
         (b (show `(,(from-of message) .
                    (form (|@| (onsubmit "return send_ex(this,'clergyman@localhost');"))
                          (p ,(cgi-get-parameter "value" a) " + ? = ?")
                          (input (|@| (type "input") (name "value")))
                          (input (|@| (type "hidden") (name "kurl") (value ,kurl)))
                          (input (|@| (type "submit") (value "send"))))))))
    (show `(,(from-of message) .
            (p ,(cgi-get-parameter "value" a) " + "
               ,(cgi-get-parameter "value" b) " = "
               ,(+ (cgi-get-parameter "value" a :convert x->number)
                   (cgi-get-parameter "value" b :convert x->number)))))))

(define (counter message)
  (define (page from to count)
    `(div
      (h1 ,count)
      (p "changed by " ,from)
      (span (|@| (style "text-decoration: underline; cursor: pointer;")
                 (onclick ,(format #f "return send_ex2('kurl=~a&from=~a&value=inc','clergyman@localhost');" kurl to)))
            "++")
      " "
      (span (|@| (style "text-decoration: underline; cursor: pointer;")
                 (onclick ,(format #f "return send_ex2('kurl=~a&from=~a&value=dec','clergyman@localhost');" kurl to)))
            "--")))
  (let loop ((from (from-of message))
             (c 0))
    (let1 value (show `("romeo@localhost/Home" .
                        ,(page from "romeo@localhost/Home" c))
                      `("juliet@localhost/Home" .
                        ,(page from "juliet@localhost/Home" c)))
      (loop
       (cgi-get-parameter "from" value)
       (if (string=? "inc" (cgi-get-parameter "value" value))
         (+ c 1)
         (- c 1))))))

(define (main args)
  (define connection (connect :hostname "localhost"))
  (auth connection "clergyman" "clergyman" "Home" :mechanism :sasl-digest-md5)
  (presence connection)
  (call-with-cont-xmpp
   (cond
    ((null? (cdr args)) marrige)
    ((string=? "marrige" (cadr args)) marrige)
    ((string=? "sum" (cadr args)) sum)
    ((string=? "counter" (cadr args)) counter)
    (else marrige)))
  ;;(guard (e (else (disconnect connection)))
  (receive-stanza-loop connection))
